home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtrsc.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  62.9 KB  |  2,008 lines
  1. IMPLEMENTATION MODULE mtRsc;
  2. (****************************************************************************
  3.  *
  4.  *    Beschreibung  : Dieses Modul ersetzt mtRsc aus der Magic-Lib.
  5.  *                    Die Aufrufe sind identisch, es handelt sich aber um
  6.  *                    ein 'Portierung' der Farb-Rsc-Untersttzung von
  7.  *                    Interface.
  8.  *
  9.  *                    Daraus ergibt sich auch der konfuse und schlecht
  10.  *                    lesbare Quelltext, da die Originale in typischer
  11.  *                    C-Manier geschrieben sind.
  12.  *
  13.  * $Source: c:\gemini\user\s_engel\RCS\MTRSC.M,v $
  14.  *
  15.  * $Revision: 1.4 $
  16.  *
  17.  * $Author: S_Engel $
  18.  *
  19.  * $Date: 1995/05/09 14:30:44 $
  20.  *
  21.  * $State: Exp $
  22.  *
  23.  *****************************************************************************
  24.  * History:
  25.  *
  26.  * $Log: MTRSC.M,v $
  27.  * Revision 1.4  1995/05/09  14:30:44  S_Engel
  28.  * Farbicons funktionieren endlich unter True Color
  29.  *
  30.  * Revision 1.3  1995/05/08  13:08:10  S_Engel
  31.  * Implementierung von GetRscHeader
  32.  *
  33.  * Revision 1.2  1995/03/25  15:47:46  S_Engel
  34.  * Bei Aufl”sungen ber 8 Bit werden keine Farbicons benutzt.
  35.  *
  36.  * Revision 1.1  1995/01/01  19:04:14  S_Engel
  37.  * Initial revision
  38.  *
  39.  *
  40.  *
  41.  ****************************************************************************)
  42.  
  43.  
  44. FROM Portab IMPORT tCompiler, Compiler;
  45.  
  46. (*$?Compiler=Haenisch:
  47. (*----------------------------------------------*)
  48. (*                                              *)
  49. (*$S-   Stack-Checks                            *)
  50. (*$I-   keine Variablen-Initialisierung         *)
  51. (*$V-   keine arithmetischen Kontrollen         *)
  52. (*$T-   kein Bereichstest                       *)
  53. (*                                              *)
  54. (*----------------------------------------------*)
  55.  *)
  56. (*$?Compiler=Megamax:
  57. (*----------------------------------------------*)
  58. (*                                              *)
  59. (* S-   Stack-Checks                            *)
  60. (*$R-   kein Bereichstest                       *)
  61. (*$K+   kein Bereichstest                       *)
  62. (*                                              *)
  63. (*----------------------------------------------*)
  64.  *)
  65.  
  66. IMPORT SYSTEM, Storage;
  67. FROM SYSTEM IMPORT ADR, ADDRESS, TSIZE;
  68.  
  69. (* HM2-Spezifika *)
  70. IMPORT Block;
  71.  
  72.  
  73. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  74.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  75.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  76.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  77.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  78.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  79.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  80.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  81.  
  82.  
  83.  
  84. IMPORT  MagicBitOps, MagicVDI, MagicStrings, MagicDOS, MagicAES, MagicTypes;
  85. IMPORT  mtAppl, mtUtils, mtXobjects;
  86.  
  87.  
  88. (*$?Compiler=Haenisch:
  89. IMPORT void;
  90. *)
  91. (*$?Compiler=Megamax:
  92. IMPORT mtVoid;          (* Dirk hat das anders *)
  93. *)
  94.  
  95. TYPE    tpRSHDR  = POINTER TO MagicTypes.RSHDR;
  96.         tpRSXHDR = POINTER TO RSXHDR;
  97.         (*
  98.         RSXHDR =  RECORD
  99.                     rshVrsn    : sCARDINAL;     (* 3 fr langen Header        *)
  100.                     rshExtvrsn : sCARDINAL;     (* 'IN' bei RSC von Interface *)
  101.                     rshObject  : lCARDINAL;
  102.                     rshTedinfo : lCARDINAL;
  103.                     rshIconblk : lCARDINAL;
  104.                     rshBitblk  : lCARDINAL;
  105.                     rshFrstr   : lCARDINAL;
  106.                     rshString  : lCARDINAL;
  107.                     rshImdata  : lCARDINAL;
  108.                     rshFrimg   : lCARDINAL;
  109.                     rshTrindex : lCARDINAL;
  110.                     rshNobs    : lCARDINAL;
  111.                     rshNtree   : lCARDINAL;
  112.                     rshNted    : lCARDINAL;
  113.                     rshNib     : lCARDINAL;
  114.                     rshNbb     : lCARDINAL;
  115.                     rshNstring : lCARDINAL;
  116.                     rshNimages : lCARDINAL;
  117.                     rshRssize  : lCARDINAL;
  118.                   END;
  119.         *)
  120.         (* Pufferstruktur fr Meisiek-Technik *)
  121.         tpRsBuffer =    POINTER TO tRsBuffer;
  122.         tRsBuffer =     RECORD
  123.                           colictab    : POINTER TO ARRAY[0..MAX(sINTEGER)] OF MagicAES.CICON;
  124.                           colicons    : sCARDINAL;
  125.                           tree        : POINTER TO ARRAY[0..MAX(sINTEGER)] OF mtUtils.tObjcTree;
  126.                           xhdr        : tpRSXHDR;
  127.                           size        : sCARDINAL;
  128.                           rscdata     : tpRSHDR;
  129.                           Reserved    : ARRAY[0..2] OF sCARDINAL;
  130.                         END;
  131.  
  132.         RESOURCE =      POINTER TO Resource;
  133.         Resource =      RECORD
  134.                           RsBuffer    : tRsBuffer;
  135.                           next        : RESOURCE;
  136.                           last        : RESOURCE;
  137.                         END;
  138.  
  139.  
  140.         tpExtSlot     = POINTER TO tExtSlot;
  141.         tExtSlot      = RECORD
  142.                           rscLen      : lCARDINAL;
  143.                           rscCIconTab : ADDRESS;
  144.                           rscFarbtbl  : ADDRESS;
  145.                         END;
  146.  
  147. TYPE  tplInt    = POINTER TO ARRAY[0..MAX(sINTEGER)] OF lINTEGER;
  148.       tpsInt    = POINTER TO ARRAY[0..MAX(sINTEGER)] OF sINTEGER;
  149.       tplCard   = POINTER TO ARRAY[0..MAX(sINTEGER)] OF lCARDINAL;
  150.       tpsCard   = POINTER TO ARRAY[0..MAX(sINTEGER)] OF sCARDINAL;
  151.  
  152.  
  153. VAR     RscList:        RESOURCE;
  154.  
  155.  
  156.  
  157. (****** VARIABLES ************************************************************)
  158.  
  159. VAR xgl_wbox, xgl_hbox : sINTEGER;
  160.  
  161. (* rs_par sollte man evtl. durch Zugriff auf Resource.RsBuffer
  162.  * ersetzen *)
  163. VAR rs_par  : POINTER TO tRsBuffer;
  164.  
  165. TYPE  table32       = ARRAY[0..255] OF ARRAY[0..31] OF sINTEGER;
  166.       table4        = ARRAY[0..255] OF ARRAY[0..3] OF sINTEGER;
  167. VAR   farbtbl       : POINTER TO table32;
  168.       rgb_palette   : POINTER TO table4;
  169.  
  170.       farbtbl2      : ARRAY[0..255] OF SYSTEM.BYTE;
  171.       is_palette    : BOOLEAN;
  172.       xpixelbytes   : sINTEGER;
  173.  
  174. PROCEDURE SHIFT (val : sINTEGER; bits : sINTEGER) : sINTEGER;
  175.  
  176. (*$? Compiler=Megamax:
  177.     TYPE sBITNUMSET = SET OF SYSTEM.BITNUM[0..15];
  178.  *)
  179.     VAR  v: sINTEGER;
  180.   BEGIN
  181. (*$? Compiler=Haenisch:
  182.     RETURN sINTEGER(SYSTEM.SHIFT(sBITSET(val), bits));
  183. *)
  184. (*$? Compiler=Megamax:
  185.     RETURN sINTEGER(SYSTEM.SHIFT (sBITNUMSET (val), bits));
  186. *)
  187.   END SHIFT;
  188.  
  189. PROCEDURE get_sub (index : sINTEGER; offset : lINTEGER; size : sCARDINAL) : SYSTEM.ADDRESS;
  190.  
  191.   BEGIN
  192.  
  193.     RETURN SYSTEM.ADDRESS(rs_par^.rscdata)
  194.            + SYSTEM.ADDRESS(offset)
  195.            + (VAL(lCARDINAL, index) * VAL(lCARDINAL, size));
  196.  
  197.   END get_sub;
  198.  
  199. PROCEDURE get_address (type : sINTEGER; index : sINTEGER) : SYSTEM.ADDRESS;
  200.  
  201. VAR the_addr  : SYSTEM.ADDRESS;
  202.     all_ptr   : RECORD
  203.                   CASE : sCARDINAL OF
  204.                     | 0 : dummy       : SYSTEM.ADDRESS;
  205.                     | 1 : string      : MagicAES.PtrSTRING;
  206.                     | 2 : dpobject    : POINTER TO ARRAY[0..MAX(sINTEGER)] OF mtUtils.tObjcTree;
  207.                     | 3 : object      : POINTER TO MagicAES.OBJECT;
  208.                     | 4 : tedinfo     : MagicAES.PtrTEDINFO;
  209.                     | 5 : iconblk     : MagicAES.PtrICONBLK;
  210.                     | 6 : bitblk      : MagicAES.PtrBITBLK;
  211.                   ELSE
  212.                      addr : POINTER TO SYSTEM.ADDRESS;
  213.                   END;
  214.                 END;
  215.  
  216.   BEGIN
  217.     the_addr := NIL;
  218.  
  219.     CASE type OF
  220.  
  221.       |MagicAES.RTREE:
  222.         all_ptr.dpobject := SYSTEM.ADDRESS(rs_par^.tree);
  223.         the_addr := all_ptr.dpobject^[index];
  224.  
  225.       |MagicAES.ROBJECT:
  226.         the_addr := get_sub (index, rs_par^.xhdr^.rshObject, SYSTEM.TSIZE(MagicAES.OBJECT));
  227.  
  228.       |MagicAES.RTEDINFO,
  229.        MagicAES.RTEPTEXT:
  230.         the_addr := get_sub (index, rs_par^.xhdr^.rshTedinfo, SYSTEM.TSIZE(MagicAES.TEDINFO));
  231.  
  232.       |MagicAES.RICONBLK,
  233.        MagicAES.RIBPMASK:
  234.         the_addr := get_sub (index, rs_par^.xhdr^.rshIconblk, SYSTEM.TSIZE(MagicAES.ICONBLK));
  235.  
  236.       |MagicAES.RBITBLK,
  237.        MagicAES.RBIDATA:
  238.         the_addr := get_sub (index, rs_par^.xhdr^.rshBitblk, SYSTEM.TSIZE(MagicAES.BITBLK));
  239.  
  240.       |MagicAES.ROBSPEC:
  241.         all_ptr.object := get_address(MagicAES.ROBJECT, index);
  242.         the_addr := SYSTEM.ADR(all_ptr.object^.obSpec);
  243.  
  244.       |MagicAES.RTEPVALID,
  245.        MagicAES.RTEPTMPLT:
  246.         all_ptr.tedinfo := get_address(MagicAES.RTEDINFO, index);
  247.         IF (type = MagicAES.RTEPVALID)
  248.           THEN
  249.             the_addr := SYSTEM.ADR(all_ptr.tedinfo^.tePvalid);
  250.           ELSE
  251.             the_addr := SYSTEM.ADR(all_ptr.tedinfo^.tePtmplt);
  252.           END;
  253.  
  254.       |MagicAES.RIBPDATA,
  255.        MagicAES.RIBPTEXT:
  256.         all_ptr.iconblk := get_address(MagicAES.RICONBLK, index);
  257.         IF (type = MagicAES.RIBPDATA)
  258.           THEN
  259.             the_addr := SYSTEM.ADR(all_ptr.iconblk^.ibPdata);
  260.           ELSE
  261.             the_addr := SYSTEM.ADR(all_ptr.iconblk^.ibPtext);
  262.           END;
  263.  
  264.       |MagicAES.RSTRING:
  265.         all_ptr.addr := get_sub (index, rs_par^.xhdr^.rshFrstr, SYSTEM.TSIZE(MagicAES.PtrSTRING));
  266.         (* Zeiger auf den String aus der Tabelle *)
  267.         the_addr := all_ptr.addr^;
  268.  
  269.       |MagicAES.RIMAGEDATA:
  270.         all_ptr.addr := get_sub (index, rs_par^.xhdr^.rshImdata, SYSTEM.TSIZE(MagicAES.PtrSTRING));
  271.         the_addr := all_ptr.addr^;
  272.  
  273.       |MagicAES.RFRIMG:
  274.         the_addr := get_sub (index, rs_par^.xhdr^.rshFrimg, SYSTEM.TSIZE(MagicAES.PtrSTRING));
  275.  
  276.       |MagicAES.RFRSTR:
  277.         (* Zeiger auf den Zeiger *)
  278.         the_addr := get_sub (index, rs_par^.xhdr^.rshFrstr, SYSTEM.TSIZE(MagicAES.PtrSTRING));
  279.  
  280.     ELSE
  281.     END;  (* CASE *)
  282.  
  283.     RETURN the_addr;
  284.  
  285.   END get_address;
  286.  
  287. PROCEDURE rs_obfix (rs_otree : mtUtils.tObjcTree; rs_oobject : sINTEGER);
  288.  
  289.   PROCEDURE fix_coord (VAR pcoord : sINTEGER; vertical : BOOLEAN; fixed: BOOLEAN);
  290.   VAR ncoord : sINTEGER;
  291.   
  292.     BEGIN
  293.  
  294.       (* Was'n das fr'n Scheiž? *)
  295.  
  296.       ncoord := pcoord MOD 256;
  297.   
  298.       IF vertical
  299.         THEN
  300.           IF fixed
  301.           THEN
  302.             ncoord := ncoord * 16;
  303.           ELSE
  304.             ncoord := ncoord * xgl_hbox;
  305.           END;
  306.         ELSIF (ncoord = 80)
  307.         THEN
  308.           ncoord := mtAppl.MaxWidth;         (* Breite des Bildschirms in Pixel *)
  309.         ELSE
  310.           IF fixed
  311.           THEN
  312.             ncoord := ncoord * 8;
  313.           ELSE
  314.             ncoord := ncoord * xgl_wbox;
  315.           END;
  316.                 (* xgl_wbox, xgl_hbox = Zeichenbreite, Zeichenh”he in Pixel *)
  317.         END;
  318.   
  319.       IF Bit15 IN sBITSET(pcoord)
  320.         THEN
  321.           ncoord := ncoord + (( pcoord DIV 256) MOD 256) + sINTEGER(0FF00H);
  322.         ELSE
  323.           ncoord := ncoord + (( pcoord DIV 256) MOD 256);
  324.         END;
  325.   
  326.       pcoord := ncoord;
  327.     END fix_coord;
  328.  
  329.  
  330. VAR  coord    : POINTER TO ARRAY[0..3] OF sINTEGER;
  331.      vertical : BOOLEAN;
  332.      count    : sINTEGER;
  333.      fixed    : BOOLEAN;
  334.  
  335.   BEGIN
  336.     vertical := FALSE;
  337.  
  338.     fixed := mtUtils.InFlag (rs_otree, rs_oobject, 13);
  339.     
  340.     coord := SYSTEM.ADR(rs_otree^[rs_oobject].obX);
  341.  
  342.     FOR count := 0 TO 3 DO
  343.       fix_coord(coord^[count], vertical, fixed);
  344.       vertical := ~vertical;
  345.     END;
  346.  
  347.  
  348.   END rs_obfix;
  349.  
  350. PROCEDURE fix_long (VAR lptr : SYSTEM.ADDRESS) : BOOLEAN;
  351.  
  352.   BEGIN
  353.     IF (lptr = NIL)
  354.       THEN
  355.         RETURN FALSE;
  356.       END;
  357.  
  358.     lptr := lptr + rs_par^.rscdata;
  359.  
  360.     RETURN TRUE;
  361.   END fix_long;
  362.  
  363. PROCEDURE fix_object;
  364. VAR count, type : sINTEGER;
  365.     obj         : POINTER TO MagicAES.OBJECT;
  366.  
  367.   BEGIN
  368.     count := VAL(sINTEGER, rs_par^.xhdr^.rshNobs) - 1;
  369.  
  370.     WHILE (count >= 0) DO
  371.       obj := get_address (MagicAES.ROBJECT, count);
  372.  
  373.       rs_obfix (mtUtils.tObjcTree(obj), 0);
  374.       type := obj^.obType MOD 256;
  375.       IF (type # MagicAES.GBOX)
  376.           AND (type # MagicAES.GIBOX)
  377.           AND (type # MagicAES.GBOXCHAR)
  378.         THEN
  379.           void.O := fix_long (obj^.obSpec.address); 
  380.         END;
  381.       DEC(count);
  382.     END; (* WHILE *)
  383.   END fix_object;
  384.  
  385. PROCEDURE rs_fixindex (VAR global : tRsBuffer);
  386.  
  387.   BEGIN
  388.     rs_par    := SYSTEM.ADR(global);
  389.     fix_object ();
  390.   END rs_fixindex;
  391.  
  392. PROCEDURE do_rsfix (size : lCARDINAL);
  393.  
  394.   PROCEDURE fix_treeindex();
  395.   VAR count : lINTEGER;
  396.       adr   : POINTER TO ARRAY[0..MAX(sINTEGER)] OF mtUtils.tObjcTree;
  397.   
  398.     BEGIN
  399.       count := rs_par^.xhdr^.rshNtree - 1;
  400.   
  401.       adr := get_sub (0, rs_par^.xhdr^.rshTrindex, SYSTEM.TSIZE(SYSTEM.ADDRESS));
  402.   
  403.       rs_par^.tree := SYSTEM.ADDRESS(adr);
  404.   
  405.       WHILE (count >= 0) DO
  406.         void.O := fix_long (adr^[VAL(SHORTINT, count)]);
  407.         DEC(count);
  408.       END;
  409.     END fix_treeindex;
  410.   
  411.   PROCEDURE fix_ptr (type : sINTEGER; index : lINTEGER) : BOOLEAN;
  412.   VAR adr : POINTER TO SYSTEM.ADDRESS;
  413.   
  414.     BEGIN
  415.       adr := get_address (type, VAL(SHORTINT, index));
  416.       RETURN fix_long (adr^);
  417.   
  418.     END fix_ptr;
  419.   
  420.   PROCEDURE fix_tedinfo();
  421.   VAR count : sINTEGER;
  422.  
  423.   VAR
  424.       tedinfo : MagicAES.PtrTEDINFO;
  425.   
  426.     BEGIN
  427.   
  428.       count := VAL (sINTEGER, rs_par^.xhdr^.rshNted) - 1;
  429.   
  430.       WHILE (count >= 0) DO
  431.         tedinfo := get_address (MagicAES.RTEDINFO, count);
  432.   
  433.         IF (fix_ptr (MagicAES.RTEPTEXT, count))
  434.           THEN
  435.             tedinfo^.teTxtlen :=  LENGTH(tedinfo^.tePtext^) + 1;
  436.           END;
  437.   
  438.         IF (fix_ptr (MagicAES.RTEPTMPLT, count))
  439.           THEN
  440.             tedinfo^.teTmplen := LENGTH(tedinfo^.tePtmplt^) + 1;
  441.           END;
  442.   
  443.         void.O := fix_ptr (MagicAES.RTEPVALID, count);
  444.   
  445.         DEC(count);
  446.       END;
  447.   
  448.     END fix_tedinfo;
  449.   
  450.   PROCEDURE fix_nptr (index : lINTEGER; ob_type : sINTEGER);
  451.   VAR adr : POINTER TO SYSTEM.ADDRESS;
  452.   
  453.     BEGIN
  454.       WHILE (index >= 0) DO
  455.         adr := get_address(ob_type, VAL( sINTEGER, index));
  456.         void.O := fix_long (adr^);
  457.         DEC(index);
  458.       END;
  459.     END fix_nptr;
  460.   
  461.  
  462.   BEGIN
  463.     rs_par^.size := size;
  464.  
  465.     (* Zeiger auf die Daten eintragen *)
  466.     rs_par^.rscdata := rs_par^.rscdata;
  467.  
  468.     fix_treeindex ();
  469.     fix_tedinfo ();
  470.  
  471.     WITH rs_par^.xhdr^ DO
  472.       fix_nptr (rshNib - 1, MagicAES.RIBPMASK);
  473.       fix_nptr (rshNib - 1, MagicAES.RIBPDATA);
  474.       fix_nptr (rshNib - 1, MagicAES.RIBPTEXT);
  475.  
  476.       fix_nptr (rshNbb - 1, MagicAES.RBIDATA);
  477.       fix_nptr (rshNstring - 1, MagicAES.RFRSTR);
  478.       fix_nptr (rshNimages - 1, MagicAES.RFRIMG);
  479.     END;
  480.   END do_rsfix;
  481.  
  482. PROCEDURE fill_cicon_liste (cicon_liste : tplInt;
  483.                             header      : lCARDINAL;
  484.                             rsxhdr      : tpRSXHDR) : sINTEGER;
  485.  
  486. VAR i, i2, num                : sINTEGER;
  487.     iclen, num_cicon, ob      : lCARDINAL;
  488.     p                         : SYSTEM.ADDRESS;
  489.     cblk                      : MagicAES.PtrCICONBLK;
  490.     cicon, cold               : MagicAES.PtrCICON;
  491.     pobject                   : mtUtils.tObjcTree;
  492.  
  493.   BEGIN
  494.     num := 0;
  495.  
  496.     WHILE (cicon_liste^[num] = 0) DO
  497.       INC(num);
  498.     END;
  499.   
  500.     IF (cicon_liste^[num] # -1)
  501.       THEN
  502.         RETURN 0;
  503.       END;
  504.  
  505.     cblk := MagicAES.PtrCICONBLK(ADR(cicon_liste^[num+1]));     (* AUA!! *)
  506.   
  507.     FOR i := 0 TO num - 1 DO
  508.       cicon_liste^[i] := lINTEGER(cblk);
  509.       p := (cblk) + ADDRESS(TSIZE(MagicAES.CICONBLK));
  510.       cblk^.mono.ibPdata := p;
  511.       iclen := (cblk^.mono.ibWicon DIV 8) * cblk^.mono.ibHicon;
  512.       p :=  p + ADDRESS(iclen);
  513.       cblk^.mono.ibPmask := p;
  514.       p := p + ADDRESS(iclen);
  515. (* Das erscheint mit so falsch zu sein (SE) *)
  516. (*      IF (p2 # NIL)*)
  517. (*         OR (header + p2 = p)*)
  518. (*         OR (p2 < rsxhdr^.rshString)*)
  519. (*         OR (p2 > rsxhdr^.rshRssize)*)
  520.       IF (cblk^.mono.ibPtext = NIL)
  521.         THEN
  522.           cblk^.mono.ibPtext := ADDRESS(p);
  523.         ELSE
  524.           cblk^.mono.ibPtext := header + ADDRESS(cblk^.mono.ibPtext);
  525.         END;
  526.  
  527.       p := p + ADDRESS(12);
  528.       cicon := MagicAES.PtrCICON(p);
  529.       cold := cicon;
  530.       num_cicon := lINTEGER(cblk^.color);
  531.       IF num_cicon > 0
  532.         THEN
  533.           cblk^.color := cicon;
  534.       
  535.           FOR i2 := 0 TO VAL (sINTEGER, num_cicon) - 1 DO
  536.             p := (cicon) + ADDRESS(TSIZE(MagicAES.CICON));
  537.             cicon^.coldata := p;
  538.             p := p + ADDRESS(iclen * VAL(lCARDINAL, cicon^.numplanes));
  539.             cicon^.colmask := p;
  540.             p := p + ADDRESS(iclen);
  541.             IF cicon^.seldata # NIL
  542.               THEN
  543.                 cicon^.seldata := p;
  544.                 p := p + ADDRESS(iclen * VAL(lCARDINAL, cicon^.numplanes));
  545.                 cicon^.selmask := p;
  546.                 p := p + ADDRESS(iclen);
  547.               END;
  548.             cicon^.nextres := MagicAES.PtrCICON(p);
  549.             cold := cicon;
  550.             cicon := MagicAES.PtrCICON(p);
  551.           END;
  552.           cold^.nextres := NIL;
  553.         END;
  554.       cblk := MagicAES.PtrCICONBLK(p);
  555.     END;  (* FOR *)
  556.  
  557.  
  558.     IF (num # 0)
  559.       THEN
  560.         pobject := header + ADDRESS(rsxhdr^.rshObject);
  561.       
  562.         FOR ob := 0 TO rsxhdr^.rshNobs - 1 DO
  563.           IF ((pobject^[ob].obType MOD 256) = MagicAES.GCICON)
  564.             THEN
  565.               pobject^[ob].obSpec.address := ADDRESS(cicon_liste^[lINTEGER(pobject^[ob].obSpec)]);
  566.             END;
  567.         END;
  568.  
  569.         Storage.ALLOCATE(rs_par^.colictab, num * SYSTEM.TSIZE(MagicAES.CICON));
  570.         IF rs_par^.colictab # NIL
  571.           THEN
  572.             Block.Clear(rs_par^.colictab, num * SYSTEM.TSIZE(MagicAES.CICON));
  573.           END;
  574.         rs_par^.colicons := num;
  575.       END;
  576.   
  577.     RETURN num;
  578.  
  579.   END fill_cicon_liste;
  580.  
  581. (*****************************************************************************)
  582. (* Testen wieviel Bytes pro Pixel im ger„teabh„ngigen Format verwendet werden*)
  583. (*****************************************************************************)
  584. (*$? Compiler = Megamax:
  585. PROCEDURE xfix_cicon (col_data : ADDRESS; len : lINTEGER; old_planes, new_planes : sINTEGER; VAR s : MagicVDI.MFDB);FORWARD;
  586. PROCEDURE std_to_byte (col_data : ADDRESS; len : lINTEGER; old_planes : sINTEGER; farbtbl2 : tplInt; s : MagicVDI.MFDB);FORWARD;
  587. PROCEDURE draw_bitblk (p : ADDRESS; x, y, w, h : sINTEGER; num_planes : sINTEGER; mode : sINTEGER; VAR index : ARRAY OF sINTEGER);FORWARD;
  588. PROCEDURE xdraw_cicon (pb : MagicAES.PtrPARMBLK) : sBITSET; FORWARD;
  589. *)
  590.  
  591. (*****************************************************************************)
  592. (* Icon ins ger„teabh„ngige Format wandeln und ggf an andere Aufl”sungen     *)
  593. (* anpassen                                                                  *)
  594. (*****************************************************************************)
  595.  
  596. PROCEDURE xadd_cicon (cicnblk : MagicAES.PtrCICONBLK; VAR obj : MagicAES.OBJECT; nub : sINTEGER) : BOOLEAN;
  597.  
  598. VAR x, y, line, xmax, best_planes, find_planes: sINTEGER;
  599.     cicn, color_icn, best_icn : MagicAES.PtrCICON;
  600.     len     : lCARDINAL;
  601.     next    : POINTER TO lCARDINAL;
  602.     d       : MagicVDI.MFDB;
  603.     selMask,
  604.     colMask : POINTER TO ARRAY [0..0FFFFH] OF sBITSET;
  605.     
  606.   BEGIN
  607.     best_icn := NIL;
  608.  
  609.     len := (cicnblk^.mono.ibWicon DIV 8) * cicnblk^.mono.ibHicon;
  610.  
  611.     color_icn := ADR(rs_par^.colictab^[nub]);
  612.  
  613.     best_planes := 1;
  614.     IF (mtAppl.Bitplanes > 8)
  615.       THEN
  616.         find_planes := 4;
  617.       ELSE
  618.         find_planes := mtAppl.Bitplanes;
  619.       END;
  620.  
  621.     cicn := cicnblk^.color;
  622.     next := ADR(cicnblk^.color);
  623.  
  624.     WHILE (cicn # NIL) DO
  625.         
  626.       next^ := LONGCARD (cicn);   (*     *next = (LONG)cicn; *)
  627.       next := ADR(cicn^.nextres);
  628.  
  629.       IF (cicn^.numplanes >= best_planes) & (cicn^.numplanes <= find_planes)
  630.         THEN
  631.           best_planes := cicn^.numplanes;
  632.           best_icn := cicn;
  633.         END;
  634.       cicn := cicn^.nextres;
  635.     END;
  636.     
  637.     IF (best_icn = NIL)       (* kein passendes Farbicon gefunden *)
  638.       THEN
  639.         RETURN FALSE;
  640.       ELSE
  641.         color_icn^ := best_icn^;
  642.       END;
  643.  
  644.     IF (best_planes > 1)
  645.       THEN
  646.         color_icn^.numplanes := mtAppl.Bitplanes;
  647.       ELSE
  648.         color_icn^.numplanes := 1;
  649.       END;
  650.     
  651.     (* Platz fr das ger„teabh„ngige Format allozieren *)
  652.     Storage.ALLOCATE (color_icn^.coldata, len * VAL(lCARDINAL, color_icn^.numplanes));
  653.     IF color_icn^.coldata = NIL
  654.       THEN
  655.         RETURN FALSE
  656.       END;
  657.     IF color_icn^.seldata # NIL
  658.       THEN
  659.         Storage.ALLOCATE (color_icn^.seldata, len * VAL(lCARDINAL, color_icn^.numplanes));
  660.         IF color_icn^.seldata = NIL
  661.           THEN
  662.             Storage.DEALLOCATE (color_icn^.coldata, 0);
  663.             RETURN FALSE
  664.           END;
  665.       END;
  666.         
  667.     IF (best_planes > 1)
  668.       THEN
  669.         IF (best_icn^.seldata = NIL)
  670.           THEN
  671.             (* Selected-Maske vorbereiten *)
  672.             Storage.ALLOCATE (color_icn^.selmask, len);
  673.             IF color_icn^.selmask = NIL
  674.               THEN
  675.                 Storage.DEALLOCATE (color_icn^.coldata, 0);
  676.                 IF color_icn^.seldata # NIL
  677.                   THEN
  678.                     Storage.DEALLOCATE (color_icn^.seldata, 0);
  679.                   END;
  680.                 RETURN FALSE;
  681.               END;
  682.     
  683.             xmax := cicnblk^.mono.ibWicon DIV 16;
  684.             
  685.             selMask := color_icn^.selmask;
  686.             colMask := best_icn^.colmask;
  687.             
  688.             FOR y := 0 TO cicnblk^.mono.ibHicon - 1 DO
  689.  
  690.               line := y * xmax;
  691.   
  692.               FOR x := 0 TO xmax -1 DO
  693.                 IF y MOD 2 # 0
  694.                   THEN
  695.                     selMask^[line+x] := colMask^[line+x] * sBITSET(0AAAAH);
  696.                   ELSE
  697.                     selMask^[line+x] := colMask^[line+x] * sBITSET(05555H);
  698.                   END;
  699.               END; (* FOR *)
  700.             END(*FOR*);
  701.           ELSE
  702.             (* Wir mssen die selmask allozieren, da sonst
  703.              * bei FreeRsc ein unbekannter Block freigegeben
  704.              * wird.
  705.              *)
  706.             Storage.ALLOCATE (color_icn^.selmask, len);
  707. (*$?Compiler=Haenisch:
  708.             Block.Move (best_icn^.selmask, color_icn^.selmask, len);
  709. *)
  710. (*$?Compiler=Megamax:
  711.             Block.Copy (best_icn^.selmask, len, color_icn^.selmask);
  712. *)
  713.           END(*IF*);
  714.  
  715.         WITH d DO
  716.           fdAddr    := color_icn^.coldata;
  717.           fdW       := cicnblk^.mono.ibWicon;
  718.           fdH       := cicnblk^.mono.ibHicon;
  719.           fdWdwidth := fdW DIV 16;
  720.           fdStand   := 1;
  721.           fdNplanes := mtAppl.Bitplanes;
  722.         END;
  723.     
  724.         xfix_cicon (best_icn^.coldata, len, best_planes, mtAppl.Bitplanes, d);
  725.         
  726.         IF (best_icn^.seldata # NIL)
  727.           THEN
  728.             d.fdAddr := color_icn^.seldata;
  729.             xfix_cicon (best_icn^.seldata, len, best_planes, mtAppl.Bitplanes, d);
  730.           END(*IF*);
  731.       ELSE
  732. (*$?Compiler=Haenisch:
  733.         Block.Move (best_icn^.coldata, color_icn^.coldata, len);
  734.         Block.Move (best_icn^.seldata, color_icn^.seldata, len);
  735. *)        
  736. (*$?Compiler=Megamax:
  737.         Block.Copy (best_icn^.coldata, len, color_icn^.coldata);
  738.         Block.Copy (best_icn^.seldata, len, color_icn^.seldata);
  739. *)        
  740.       END;
  741.  
  742.     color_icn^.nextres := cicnblk^.color;
  743.     cicnblk^.color:= color_icn;
  744.  
  745.     (* und als Userdef mit draw_cicon *)
  746.     RETURN mtXobjects.InstUserdef (ADR(obj), 0, xdraw_cicon, rs_par^.colictab);
  747.     
  748.   END xadd_cicon;
  749.  
  750.  
  751. (*****************************************************************************)
  752. (* Unter TrueColor Pixelwerte der RGB-Palette ermitteln                      *)
  753. (*****************************************************************************)
  754.  
  755. PROCEDURE xfill_farbtbl ();
  756. TYPE    PixArray = ARRAY [0..15] OF sINTEGER;
  757. VAR 
  758.     i, np, color: sINTEGER;
  759.     pxy         : ARRAY [0..7] OF sINTEGER;
  760.     backup      : ARRAY [0..31] OF sINTEGER;
  761.     rgb         : ARRAY [0..2] OF sINTEGER;
  762.     pixel,
  763.     stdfm,
  764.     screen      : MagicVDI.MFDB;
  765.     pixtbl      : PixArray;
  766.  
  767.   BEGIN
  768.     stdfm := MagicVDI.MFDB{NIL, 16, 1, 1, 1, 1, 0, 0, 0};
  769.     pixel := MagicVDI.MFDB{NIL, 16, 1, 1, 0, 1, 0, 0, 0};
  770.     pixtbl := PixArray{0, 2, 3, 6, 4, 7, 5, 8, 9, 10, 11, 14, 12, 15, 13, 16};
  771.     IF (mtAppl.Bitplanes >= 8)
  772.       THEN
  773.         IF (mtAppl.Bitplanes > 8)
  774.           THEN
  775.             IF ~is_palette    (* Keine Palette in der Resource *)
  776.               THEN
  777.                 FOR color := 0 TO 254 DO 
  778.                   IF (color < 16)
  779.                     THEN
  780.                       MagicVDI.InqColor (mtAppl.VDIHandle, pixtbl[color], FALSE, rgb_palette^[color]);
  781.                       rgb_palette^[color][3] := pixtbl[color];
  782.                     ELSE
  783.                       MagicVDI.InqColor (mtAppl.VDIHandle, color-1, FALSE, rgb_palette^[color]);
  784.                       rgb_palette^[color][3] := color -1;
  785.                     END;
  786.                 END(*FOR*);
  787.                 MagicVDI.InqColor (mtAppl.VDIHandle, 1, FALSE, rgb_palette^[255]);
  788.                 rgb_palette^[255][3] := 1;
  789.                 is_palette := TRUE;
  790.               END;
  791.             
  792.             MagicVDI.SetClipping (mtAppl.VDIHandle, pxy, FALSE);
  793.             MagicAES.GrafMouse (MagicAES.MOFF, NIL);
  794.  
  795.             Block.Clear (ADR(backup), SIZE(backup));
  796.             Block.Clear (farbtbl, SIZE(farbtbl^));
  797.             screen.fdAddr := NIL;
  798.             stdfm.fdNplanes := mtAppl.Bitplanes;
  799.             pixel.fdNplanes := mtAppl.Bitplanes;
  800.         
  801.             i := MagicVDI.SetWritemode (mtAppl.VDIHandle, MagicVDI.REPLACE);
  802.             MagicVDI.SetLineEndstyles (mtAppl.VDIHandle, 0, 0);
  803.             i := MagicVDI.SetLinetype (mtAppl.VDIHandle, 1);
  804.             i := MagicVDI.SetLinewidth (mtAppl.VDIHandle, 1);
  805.             Block.Clear (ADR(pxy), SIZE(pxy));
  806.             
  807.             pixel.fdAddr := ADR(backup); (* Punkt retten *)
  808.             MagicVDI.CopyRasterOpaque (mtAppl.VDIHandle, 3, pxy, screen, pixel);
  809.         
  810.             (* Alte Farbe retten *)
  811.             MagicVDI.InqColor (mtAppl.VDIHandle, 15, FALSE, rgb);
  812.  
  813.             FOR color := 0 TO 255 DO
  814.               MagicVDI.SetColor (mtAppl.VDIHandle, 15, rgb_palette^[color]);
  815.               i := MagicVDI.SetLinecolor (mtAppl.VDIHandle, 15);
  816.               MagicVDI.Polyline (mtAppl.VDIHandle, 2, pxy);
  817.  
  818.               stdfm.fdAddr := ADR(farbtbl^[color]);
  819.               pixel.fdAddr := ADR(farbtbl^[color]);
  820.  
  821.               (* vro_cpyfm, weil v_get_pixel nicht mit TrueColor (>=24 Planes) funktioniert *)
  822.               MagicVDI.CopyRasterOpaque (mtAppl.VDIHandle, 3, pxy, screen, pixel);
  823.  
  824.               IF xpixelbytes # 0
  825.                 THEN
  826.                   farbtbl2[color] := SYSTEM.BYTE(0);
  827. (*$? Compiler=Haenisch:                  
  828.                   Block.Move (pixel.fdAddr, ADR(farbtbl2[color]), xpixelbytes);
  829. *)
  830. (*$? Compiler=Megamax:
  831.                   Block.Copy (pixel.fdAddr, xpixelbytes, ADR(farbtbl2[color]));
  832. *)
  833.                 END;
  834.  
  835.               MagicVDI.TransformForm (mtAppl.VDIHandle, pixel, stdfm);
  836.               FOR np := 0 TO mtAppl.Bitplanes - 1 DO
  837.                 IF (farbtbl^[color][np] # 0)
  838.                   THEN
  839.                     farbtbl^[color][np] := -1;
  840.                   END(*IF*);
  841.               END(*FOR*);
  842.             END(*FOR*);
  843.         
  844.             (* Alte Farbe restaurieren *)
  845.             MagicVDI.SetColor (mtAppl.VDIHandle, 15, rgb);
  846.  
  847.             pixel.fdAddr := ADR(backup); (* Punkt restaurieren *)
  848.             MagicVDI.CopyRasterOpaque (mtAppl.VDIHandle, 3, pxy, pixel, screen);
  849.         
  850.             MagicAES.GrafMouse (MagicAES.MON, NIL);
  851.           ELSE  (* mtAppl.Bitplanes > 8 *)
  852.             IF xpixelbytes # 0
  853.               THEN
  854.                 FOR color := 0 TO 255 DO
  855. (*$? Compiler=Haenisch:
  856.                   farbtbl2[color] := VAL(SYSTEM.BYTE, color);
  857.  *)
  858. (*$? Compiler=Megamax:
  859.                   farbtbl2[color] := SHORT(color);
  860.  *)
  861.                 END;
  862.               END;
  863.           END;
  864.       END;
  865.  
  866.   END xfill_farbtbl;
  867.  
  868. (*****************************************************************************)
  869. (* Icon an aktuelle Grafikaufl”sung anpassen                                 *)
  870. (* (z.B. 4 Plane Icon an 24 Plane TrueColor)                                 *)
  871. (*****************************************************************************)
  872. PROCEDURE xfix_cicon (col_data : ADDRESS; len : lINTEGER; old_planes, new_planes : sINTEGER; VAR s : MagicVDI.MFDB);
  873. VAR
  874.     x, i, old_len, rest_len, (*$Reg *) pos : lINTEGER;
  875.     mul : ARRAY [0..31] OF lINTEGER;
  876.     (*$Reg*) np, mask, pixel, (*$Reg*) bit, color, maxcol : sCARDINAL;
  877.     back, 
  878.     old_col : ARRAY [0..31] OF sCARDINAL;
  879.     new_data: POINTER TO sCARDINAL;
  880.     (*$Reg*) dataPtr : POINTER TO ARRAY [0..0FFFFFFH] OF sCARDINAL;
  881.     got_mem : BOOLEAN;
  882.     d       : MagicVDI.MFDB;
  883.  
  884.   BEGIN
  885.     got_mem := FALSE;
  886.     len := len DIV 2;
  887.  
  888.     IF (old_planes = new_planes)
  889.       THEN
  890.         IF (new_planes = mtAppl.Bitplanes)
  891.           THEN
  892.             d := s;
  893.             d.fdStand := 0;
  894.             s.fdAddr := col_data;
  895.             IF (d.fdAddr = s.fdAddr)
  896.               THEN
  897.                 Storage.ALLOCATE (d.fdAddr, len * 2 * VAL(lINTEGER, new_planes));
  898.                 IF (d.fdAddr = NIL)
  899.                   THEN
  900.                     d.fdAddr := s.fdAddr;
  901.                   ELSE
  902.                     got_mem := TRUE;
  903.                   END;
  904.               END;
  905.             
  906.             MagicVDI.TransformForm (mtAppl.VDIHandle, s, d);
  907.             
  908.             IF (d.fdAddr # s.fdAddr) & got_mem 
  909.               THEN
  910. (*$? Compiler=Haenisch:
  911.                 Block.Move (d.fdAddr, s.fdAddr, len*2*new_planes);
  912. *)
  913. (*$? Compiler=Megamax:
  914.                 Block.Copy (d.fdAddr, len*2*LONG(new_planes), s.fdAddr);
  915. *)
  916.                 Storage.DEALLOCATE (d.fdAddr, 0);
  917.               END;
  918.           ELSE
  919. (*$? Compiler=Haenisch:
  920.             Block.Move (s.fdAddr, col_data, len*2*new_planes);
  921. *)
  922. (*$? Compiler=Megamax:
  923.             Block.Copy (s.fdAddr, len*2*LONG(new_planes), col_data);
  924. *)
  925.           END;
  926.         RETURN;
  927.       END; (* IF old_planes = new_planes *)
  928.  
  929.     old_len  := VAL(lINTEGER, old_planes) * len;
  930.     rest_len := VAL(lINTEGER, new_planes) * len - old_len;
  931.     
  932.     IF (new_planes <= 8)
  933.       THEN
  934.         dataPtr := s.fdAddr;
  935.  
  936.         new_data := ADR(dataPtr^[old_len]);
  937.         Block.Clear (new_data, rest_len*2);
  938. (*$? Compiler=Haenisch:
  939.         Block.Move (col_data, s.fdAddr, old_len*2);
  940. *)
  941. (*$? Compiler=Megamax:
  942.         Block.Copy (col_data, old_len*2, s.fdAddr);
  943. *)
  944.         col_data := s.fdAddr;
  945.         
  946.         FOR x := 0 TO len -1 DO 
  947.             
  948.           mask := 0FFFFH;
  949.  
  950.           i := 0;
  951.           dataPtr := col_data;
  952.           WHILE i < old_len DO
  953.             mask := sCARDINAL(sBITSET(mask) * sBITSET(dataPtr^[x+i]));
  954.             INC (i, len);
  955.           END;
  956.  
  957.           IF mask # 0
  958.             THEN
  959.               i := 0;
  960.               dataPtr := ADDRESS(new_data);
  961.               WHILE i < rest_len DO
  962.                 dataPtr^[x+i] := sCARDINAL(sBITSET(mask)+sBITSET(dataPtr^[x+1]));
  963.                 INC (i, len);
  964.               END;
  965.             END;
  966.         END;
  967.  
  968.         (* ins ger„teabh„ngige Format konvertieren *)
  969.         d := s;
  970.         d.fdStand := 0;
  971.         Storage.ALLOCATE (d.fdAddr, len * 2 * VAL(lINTEGER, new_planes));
  972.         IF d.fdAddr = NIL
  973.           THEN
  974.             d.fdAddr := s.fdAddr;
  975.           END;
  976.         
  977.         MagicVDI.TransformForm (mtAppl.VDIHandle, s, d);
  978.         IF d.fdAddr # s.fdAddr
  979.           THEN
  980. (*$? Compiler=Haenisch:
  981.             Block.Move (d.fdAddr, s.fdAddr, len*2*new_planes);
  982. *)
  983. (*$? Compiler=Megamax:
  984.             Block.Copy (d.fdAddr, len*2*LONG(new_planes), s.fdAddr);
  985. *)
  986.             Storage.DEALLOCATE (d.fdAddr, 0);
  987.           END;
  988.       ELSE    (* TrueColor, bzw RGB-orientierte Pixelwerte *)
  989.         IF (xpixelbytes = 0)
  990.         THEN
  991.             FOR i := 0 TO VAL(lINTEGER, new_planes) -1 DO
  992.                 mul[i] := i * len;
  993.             END;
  994.             
  995.             IF (old_planes < 8)
  996.               THEN
  997.                 maxcol := SHIFT (1, old_planes) - 1;
  998. (*$? Compiler=Haenisch:
  999.                 Block.Move (ADR(farbtbl^[maxcol]), ADR(old_col), new_planes * TSIZE (sCARDINAL));
  1000. *)
  1001. (*$? Compiler=Megamax:
  1002.                 Block.Copy (ADR(farbtbl^[maxcol]), new_planes * TSIZE (sCARDINAL), ADR(old_col) );
  1003. *)
  1004.                 Block.Clear (ADR(farbtbl^[maxcol]), new_planes * TSIZE (sCARDINAL));
  1005.               END;
  1006.             dataPtr := s.fdAddr;
  1007.             new_data := ADR(dataPtr^[old_len]);
  1008.             Block.Clear (new_data, rest_len * 2);
  1009. (*$? Compiler=Haenisch:
  1010.             Block.Move(col_data, s.fdAddr, old_len*2);
  1011. *)
  1012. (*$? Compiler=Megamax:
  1013.             Block.Copy (col_data, old_len*2, s.fdAddr);
  1014. *)
  1015.             col_data := s.fdAddr;
  1016.             
  1017.             FOR x := 0 TO len -1 DO
  1018.               bit := 1;
  1019.               dataPtr := col_data;
  1020.               FOR np := 0 TO sCARDINAL(old_planes) -1 DO
  1021.                 back[np] := dataPtr^[mul[np] + x];
  1022.               END;
  1023.  
  1024.               FOR pixel := 0 TO 15 DO
  1025.  
  1026.                 color := 0;
  1027.                 FOR np := 0 TO sCARDINAL(old_planes) -1 DO
  1028.                   IF ODD(back[np])
  1029.                     THEN
  1030.                       color := color + sCARDINAL(SHIFT (1, np));
  1031.                     END;
  1032.                   back[np] := back[np] DIV 2;
  1033.                 END;
  1034.  
  1035.                 FOR np := 0 TO sCARDINAL(new_planes) - 1 DO
  1036.                   pos := mul[np] + x;
  1037. (*$? Compiler = Megamax:
  1038.                   dataPtr^[pos] := sCARDINAL((sBITSET(dataPtr^[pos]) * SYSTEM.CAST(sBITSET, 0FFFFH-bit)) +
  1039.  *)
  1040. (*$? Compiler = Haenisch:
  1041.                   dataPtr^[pos] := sCARDINAL((sBITSET(dataPtr^[pos]) * VAL(sBITSET, 0FFFFH-bit)) +
  1042.  *)
  1043.                                             (sBITSET(farbtbl^[color, np]) * sBITSET(bit)));
  1044.                 END;
  1045.  
  1046.                 bit := bit*2;
  1047.               END;
  1048.             END; (* FOR x := 0 TO ... *)
  1049.             IF (old_planes < 8)
  1050.               THEN
  1051. (*$? Compiler=Haenisch:
  1052.                 Block.Move (ADR(old_col), ADR(farbtbl^[maxcol]), new_planes*TSIZE (sCARDINAL));
  1053. *)
  1054. (*$? Compiler=Megamax:
  1055.                 Block.Copy (ADR(old_col), new_planes*TSIZE (sCARDINAL), ADR(farbtbl^[maxcol]));
  1056. *)
  1057.               END;
  1058.  
  1059.             (* ins ger„teabh„ngige Format konvertieren *)
  1060.             d := s;
  1061.             d.fdStand := 0;
  1062.             Storage.ALLOCATE (d.fdAddr, len * 2 * VAL(lINTEGER, new_planes));
  1063.             IF d.fdAddr = NIL
  1064.               THEN
  1065.                 d.fdAddr := s.fdAddr;
  1066.               END;
  1067.             
  1068.             MagicVDI.TransformForm (mtAppl.VDIHandle, s, d);
  1069.             IF (d.fdAddr # s.fdAddr)
  1070.               THEN
  1071. (*$? Compiler=Haenisch:
  1072.                 Block.Move(d.fdAddr, s.fdAddr, len*2*new_planes);
  1073. *)
  1074. (*$? Compiler=Megamax:
  1075.                 Block.Copy(d.fdAddr, len*2*LONG(new_planes), s.fdAddr);
  1076. *)
  1077.                 Storage.DEALLOCATE (d.fdAddr, 0);
  1078.               END;
  1079.         ELSE (* IF xpixelbytes = 0 *)
  1080.           std_to_byte (col_data, len, old_planes, ADR(farbtbl2), s);
  1081.         END;
  1082.       END;
  1083.  
  1084.   END xfix_cicon;
  1085.  
  1086. (*****************************************************************************)
  1087. (* std_to_byte wandelt eine Grafik im Standardformat direkt ins ger„te-      *)
  1088. (* abh„ngige Format (in Aufl”sungen mit >= 16 Planes)                        *)
  1089. (*****************************************************************************)
  1090. PROCEDURE std_to_byte (col_data : ADDRESS; len : lINTEGER; old_planes : sINTEGER; farbtbl2 : tplInt; s : MagicVDI.MFDB);
  1091.  
  1092. VAR
  1093.     x, i, pos             : lINTEGER;
  1094.     mul                   : ARRAY [0..31] OF lINTEGER;
  1095.     np, pixel, color      : sCARDINAL;
  1096.     new_data              : POINTER TO sCARDINAL;
  1097.     back                  : ARRAY [0..31] OF sCARDINAL;
  1098.     memflag               : BOOLEAN;
  1099.     p1, p2                : POINTER TO SYSTEM.BYTE;
  1100.     colback               : lCARDINAL;
  1101.     lptr,
  1102.     f_tbl                 : POINTER TO ARRAY [0..0FFFFFFFH] OF lCARDINAL;
  1103.     dataPtr               : POINTER TO ARRAY [0..0FFFFFFH] OF sCARDINAL;
  1104.     tmp                   : sBITSET;
  1105.  
  1106. BEGIN
  1107.     memflag := FALSE;
  1108.     IF (s.fdAddr = col_data)
  1109.       THEN
  1110.         Storage.ALLOCATE (col_data, len * 2 * VAL(lINTEGER, s.fdNplanes));
  1111.         IF (col_data = NIL)
  1112.           THEN
  1113.             RETURN;
  1114.           END;
  1115. (*$? Compiler=Haenisch:
  1116.         Block.Move(s.fdAddr, col_data, len*2*s.fdNplanes);
  1117. *)
  1118. (*$? Compiler=Megamax:
  1119.         Block.Copy(s.fdAddr, len*2*LONG(s.fdNplanes), col_data);
  1120. *)
  1121.         memflag := TRUE;
  1122.       END;
  1123.     new_data := s.fdAddr;
  1124.     p1 := ADDRESS(new_data);
  1125.  
  1126.     IF (old_planes < 8)
  1127.       THEN
  1128.         f_tbl := ADDRESS(farbtbl2);
  1129.         colback := f_tbl^[ SHIFT(1, old_planes) - 1];
  1130.         f_tbl^[SHIFT(1, old_planes) - 1] := f_tbl^[255];
  1131.       END;
  1132.         
  1133.     FOR i := 0  TO VAL(lINTEGER, old_planes) -1 DO
  1134.       mul[i] := i * len;
  1135.     END;
  1136.     
  1137.     pos := 0;
  1138.     
  1139.     FOR x := 0 TO len-1 DO
  1140.       dataPtr := col_data;
  1141.       FOR np := 0 TO sCARDINAL(old_planes)-1 DO
  1142.         back[np] := dataPtr^[mul[np] + x];
  1143.       END;
  1144.  
  1145.       FOR pixel := 0 TO 15 DO
  1146.         color := 0;
  1147.         FOR np := 0 TO sCARDINAL(old_planes)-1 DO
  1148.           color := sCARDINAL(sBITSET(color) + sBITSET(SHIFT(sCARDINAL(sBITSET (back[np]) * sBITSET(08000H)), np - 15)));
  1149.           back[np] := back[np] * 2;
  1150.         END;
  1151.  
  1152.         f_tbl := ADDRESS(farbtbl2);
  1153.         CASE xpixelbytes OF
  1154.             2:
  1155.                 dataPtr := ADDRESS(new_data);
  1156.                 dataPtr^[pos] := VAL(sCARDINAL, f_tbl^[color]);
  1157.                 INC (pos); |
  1158.             3:
  1159.                 p2 := ADR(f_tbl^[color]);
  1160.                 (*
  1161.                 p2 := (UBYTE * )&farbtbl2[color];
  1162.                 *)
  1163.                 FOR i := 0 TO 2 DO
  1164.                   p1^ := p2^; INC (p1); INC (p2);
  1165.                 END;
  1166.                 |
  1167.             4:
  1168.                 lptr := ADDRESS(new_data);
  1169.                 lptr^[pos] := f_tbl^[color];
  1170.                 INC (pos);
  1171.         ELSE
  1172.         END;
  1173.       END; (* FOR pixel *)
  1174.     END; (* FOR x *)
  1175.  
  1176.     IF (old_planes < 8)
  1177.       THEN
  1178.         f_tbl := ADDRESS(farbtbl2);
  1179.         f_tbl^[SHIFT(1, old_planes) - 1] := colback;
  1180.       END;
  1181.  
  1182.     IF memflag
  1183.       THEN
  1184.         Storage.DEALLOCATE (col_data, 0);
  1185.       END;
  1186.  
  1187.   END std_to_byte;
  1188.  
  1189.  
  1190. (*****************************************************************************)
  1191. (* Zeichnet Farb-Icon                                                        *)
  1192. (*****************************************************************************)
  1193. (*$?Compiler=Haenisch: (*$E+ $K+*) *)
  1194. PROCEDURE xdraw_cicon (pb : MagicAES.PtrPARMBLK) : sBITSET;
  1195. VAR
  1196.   ob_x, ob_y, x, y,
  1197.   dummy, m_mode,
  1198.   i_mode, mskcol,
  1199.   icncol              : sINTEGER;
  1200.   pxy                 : ARRAY[0..4] OF sINTEGER;
  1201.   ob_spec             : lCARDINAL;
  1202.   iconblk             : MagicAES.PtrICONBLK;
  1203.   cicn                : MagicAES.PtrCICON;
  1204.   mask, data, dark    : ADDRESS;
  1205.   letter              : ARRAY[0..1] OF CHAR;
  1206.   selected            : BOOLEAN;
  1207.   buf                 : sINTEGER;
  1208.   mindex, iindex      : ARRAY[0..1] OF sINTEGER;
  1209.   invert              : BOOLEAN;
  1210.   pRect               : POINTER TO mtUtils.tRect;
  1211.   Rect                : mtUtils.tRect;
  1212.  
  1213.   BEGIN
  1214.     invert := FALSE;
  1215.     mask := NIL;
  1216.     data := NIL;
  1217.     dark := NIL;
  1218.  
  1219.     (*$?Compiler=Haenisch:
  1220.     selected := MagicAES.SELECTED IN pb^.pbCurrstate;   (* SE hat Namen korrigiert *)
  1221.     *)
  1222.     (*$?Compiler=Megamax:
  1223.     selected := MagicAES.SELECTED IN pb^.prCurrstate;
  1224.     *)
  1225.     
  1226.     pRect := SYSTEM.ADR(pb^.pbXc);
  1227.     Rect := pRect^;
  1228.     mtUtils.AbsRect(Rect);
  1229.     MagicVDI.SetClipping(mtAppl.VDIHandle, Rect, TRUE);   (* Setze Rechteckausschnitt *)
  1230.  
  1231.     WITH pb^ DO
  1232.       ob_spec := pbParm;
  1233.       ob_x    := pbX;
  1234.       ob_y    := pbY;
  1235.     END;
  1236.   
  1237.     iconblk := MagicAES.PtrICONBLK(ob_spec);
  1238. (*$? Compiler=Megamax:    (*$A+*) *)
  1239.     cicn    := MagicAES.PtrCICONBLK(ob_spec)^.color;
  1240. (*$? Compiler=Megamax:    (*$A=*) *)
  1241.     m_mode  := MagicVDI.TRANSPARENT;
  1242.   
  1243.     IF selected (* it was an objc_change *)
  1244.       THEN
  1245.         IF (cicn^.seldata # NIL)
  1246.           THEN
  1247.             mask := cicn^.selmask;
  1248.             data := cicn^.seldata;
  1249.             IF (cicn^.numplanes > 1)
  1250.               THEN
  1251.                 IF (cicn^.numplanes > 8) (* TrueColor, bzw RGB-orientierte Grafikkarte? *)
  1252.                   THEN
  1253.                     i_mode := MagicVDI.S_AND_D;
  1254.                   ELSE
  1255.                     i_mode := MagicVDI.S_OR_D;
  1256.                   END;
  1257.               ELSE
  1258.                 i_mode := MagicVDI.TRANSPARENT;
  1259.               END;
  1260.           ELSE
  1261.             mask := cicn^.colmask;
  1262.             data := cicn^.coldata;
  1263.  
  1264.             IF (cicn^.numplanes > 1)
  1265.               THEN
  1266.                 IF (cicn^.numplanes > 8)
  1267.                   THEN
  1268.                     i_mode := MagicVDI.S_AND_D;
  1269.                   ELSE
  1270.                     i_mode := MagicVDI.S_OR_D;
  1271.                   END;
  1272.                 dark := cicn^.selmask;
  1273.               ELSE
  1274.                 invert := TRUE;
  1275.               END;
  1276.           END;
  1277.       ELSE
  1278.         mask := cicn^.colmask;
  1279.         data := cicn^.coldata;
  1280.       
  1281.         IF (cicn^.numplanes > 1)
  1282.           THEN
  1283.             IF (cicn^.numplanes > 8)
  1284.               THEN
  1285.                 i_mode := MagicVDI.S_AND_D;
  1286.               ELSE
  1287.                 i_mode := MagicVDI.S_OR_D;
  1288.               END;
  1289.           ELSE
  1290.             i_mode := MagicVDI.TRANSPARENT;
  1291.           END;
  1292.       END;
  1293.  
  1294.     WITH iconblk^ DO
  1295.       IF sBITSET(ibChar) * sBITSET(00F00H) = sBITSET(00100H)
  1296.         THEN
  1297.           mindex[0] := SHIFT(sINTEGER(sBITSET(ibChar) * sBITSET(00F00H)), -8);
  1298.         ELSE
  1299.           mindex[0] := 0;
  1300.         END;
  1301.       mindex [1] := 0;
  1302.       
  1303.       icncol := SHIFT(sINTEGER(sBITSET(ibChar) * sBITSET(0F000H)), -12);
  1304.       iindex[0] := icncol;
  1305.       iindex[1] := MagicAES.WHITE;
  1306.     
  1307.       mskcol := SHIFT(sINTEGER(sBITSET(ibChar) * sBITSET(00F00H)), -8);
  1308.     
  1309.       x := ob_x + ibXicon;
  1310.       y := ob_y + ibYicon;
  1311.     
  1312.       IF (invert)
  1313.         THEN
  1314.           buf       := iindex[0];
  1315.           iindex[0] := mindex[0];
  1316.           mindex[0] := buf;
  1317.           i_mode    := MagicVDI.TRANSPARENT;
  1318.         END;
  1319.       IF (selected)
  1320.         THEN
  1321.           buf    := icncol;
  1322.           icncol := mskcol;
  1323.           mskcol := buf;
  1324.         END;
  1325.       
  1326.       draw_bitblk (mask, x, y, ibWicon, ibHicon, 1, m_mode, mindex);
  1327.       draw_bitblk (data, x, y, ibWicon, ibHicon, cicn^.numplanes, i_mode, iindex);
  1328.       
  1329.       IF (dark # NIL)
  1330.         THEN
  1331.           mindex [0] := MagicAES.BLACK;
  1332.           mindex [1] := MagicAES.WHITE;
  1333.           draw_bitblk (dark, x, y, ibWicon, ibHicon, 1, MagicVDI.TRANSPARENT, mindex);
  1334.         END;
  1335.   
  1336.       IF (ibPtext^[0] # 0C)
  1337.         THEN
  1338.           x := ob_x + ibXtext;
  1339.           y := ob_y + ibYtext;
  1340.   
  1341.           pxy[0] := x;
  1342.           pxy[1] := y;
  1343.           pxy[2] := x + ibWtext - 1;
  1344.           pxy[3] := y + ibHtext - 1;
  1345.   
  1346.           void.I := MagicVDI.SetWritemode    (mtAppl.VDIHandle, MagicVDI.REPLACE);    (* Textbox zeichnen *)
  1347.           void.I := MagicVDI.SetFillcolor    (mtAppl.VDIHandle, mskcol);
  1348.           void.I := MagicVDI.SetFillinterior (mtAppl.VDIHandle, MagicVDI.Full);
  1349.           void.O := MagicVDI.SetFillperimeter(mtAppl.VDIHandle, FALSE);
  1350.           MagicVDI.Bar         (mtAppl.VDIHandle, pxy);
  1351.         END;
  1352.     
  1353.       void.I := MagicVDI.SetWritemode(mtAppl.VDIHandle, MagicVDI.TRANSPARENT);
  1354.       void.I := MagicVDI.SetTextface(mtAppl.VDIHandle, 1); (* Systemfont *)
  1355.       MagicVDI.SetCharheight(mtAppl.VDIHandle, 4, dummy, dummy, dummy, dummy);
  1356.       void.I := MagicVDI.SetTextcolor(mtAppl.VDIHandle, icncol);
  1357.       void.B := MagicVDI.SetTexteffect(mtAppl.VDIHandle, sBITSET{});
  1358.       MagicVDI.SetTextalignment(mtAppl.VDIHandle, MagicVDI.LeftJust, MagicVDI.TopJust, dummy, dummy);
  1359.       void.I := MagicVDI.SetCharbaseline(mtAppl.VDIHandle, 0);
  1360.       
  1361.       (*$?Compiler=Megamax: (*$A+*) *)
  1362.       IF MagicAES.PtrSTRING(iconblk^.ibPtext)^[0] # 0C
  1363.         THEN
  1364.       (*$?Compiler=Megamax: (*$A=*) *)
  1365.           x := x + (ibWtext - VAL(sINTEGER, LENGTH(ibPtext^)) * 6) DIV 2;
  1366.           y := y + (ibHtext - 6) DIV 2;
  1367.   
  1368.           MagicVDI.Text (mtAppl.VDIHandle, x, y, ibPtext^);
  1369.         END;
  1370.     
  1371.       letter[0] := CHR(iconblk^.ibChar MOD 256);
  1372.       IF (letter[0] # 0C)
  1373.         THEN
  1374.           letter[1] := 0C;
  1375.           x := ob_x + ibXicon + ibXchar;
  1376.           y := ob_y + ibYicon + ibYchar;
  1377.           MagicVDI.Text (mtAppl.VDIHandle, x, y, letter);
  1378.         END;
  1379.     END;  (* WITH iconblk^ *)
  1380.  
  1381.     MagicVDI.SetClipping(mtAppl.VDIHandle, Rect, FALSE);   (* und wieder aus *)
  1382.  
  1383.     (*$?Compiler=Haenisch:
  1384.     RETURN (pb^.pbCurrstate - sBITSET{MagicAES.SELECTED});  (* SE hat Namen korrigiert *)
  1385.     *)
  1386.     (*$?Compiler=Megamax:
  1387.     RETURN (pb^.prCurrstate - sBITSET{MagicAES.SELECTED});
  1388.     *)
  1389.  
  1390.   END xdraw_cicon;
  1391. (*$?Compiler=Haenisch: (*$E= $K=*) *)
  1392.  
  1393. PROCEDURE draw_bitblk (p : ADDRESS; x, y, w, h : sINTEGER; num_planes : sINTEGER; mode : sINTEGER; VAR index : ARRAY OF sINTEGER);
  1394. VAR pxy : ARRAY[0..7] OF sINTEGER;
  1395.     s, d : MagicVDI.MFDB;
  1396.  
  1397.   BEGIN
  1398.  
  1399.     d.fdAddr      := NIL; (* screen *)
  1400.     WITH s DO
  1401.       fdAddr      := p;
  1402.       fdW         := w;
  1403.       fdH         := h;
  1404.       fdWdwidth   := w DIV 16;
  1405.       fdStand     := 0;
  1406.       fdNplanes   := num_planes;
  1407.     END;
  1408.  
  1409.     pxy[0] := 0;
  1410.     pxy[1] := 0;
  1411.     pxy[2] := s.fdW - 1;
  1412.     pxy[3] := s.fdH - 1;
  1413.  
  1414.     pxy[4] := x;
  1415.     pxy[5] := y;
  1416.     pxy[6] := pxy[4] + pxy [2];
  1417.     pxy[7] := pxy[5] + pxy [3];
  1418.  
  1419.     IF (num_planes > 1)
  1420.       THEN
  1421.         MagicVDI.CopyRasterOpaque(mtAppl.VDIHandle, mode, pxy, s, d);
  1422.       ELSE
  1423.         MagicVDI.CopyRasterTransparent(mtAppl.VDIHandle, mode, index[0], index[1], pxy, s, d);   (* copy it *)
  1424.       END;
  1425.   END draw_bitblk;
  1426.  
  1427.  
  1428.  
  1429.  
  1430. (*****************************************************************************)
  1431. (* Farbicons fr aktuelle Aufl”sung initialisieren                           *)
  1432. (*****************************************************************************)
  1433. PROCEDURE do_ciconfix (header : SYSTEM.ADDRESS; rsxhdr : tpRSXHDR; rs_len : lCARDINAL);
  1434.  
  1435.   PROCEDURE test_rez (): sINTEGER;
  1436.   
  1437.    TYPE   rgbArray = ARRAY [0..2] OF sINTEGER;
  1438.    VAR 
  1439.       i, np, color, bpp: sINTEGER;
  1440.       pxy     : ARRAY [0..7] OF sINTEGER;
  1441.       black,
  1442.       white,
  1443.       rgb     : rgbArray;
  1444.       test,
  1445.       backup  : ARRAY [0..31] OF sCARDINAL;
  1446.       pixel,
  1447.       stdfm, 
  1448.       screen  : MagicVDI.MFDB;
  1449.   
  1450.   
  1451.     BEGIN
  1452.       pixel := MagicVDI.MFDB {NIL, 16, 1, 1, 0, 1, 0, 0, 0};
  1453.       stdfm := MagicVDI.MFDB {NIL, 16, 1, 1, 1, 1, 0, 0, 0};
  1454.       white := rgbArray{1000, 1000, 1000};
  1455.       black := rgbArray{0, 0, 0};
  1456.       bpp := 0;
  1457.   
  1458.       IF (mtAppl.Bitplanes >= 8)
  1459.         THEN
  1460.           stdfm.fdNplanes := mtAppl.Bitplanes;
  1461.           pixel.fdNplanes := mtAppl.Bitplanes;
  1462.   
  1463.           IF (mtAppl.Bitplanes = 8)
  1464.             THEN
  1465.               color := 0FFH;
  1466.               Block.Clear (ADR (test), SIZE(test));
  1467.               FOR np := 0 TO mtAppl.Bitplanes - 1 DO 
  1468.                 test[np] := SHIFT(SHIFT(1, np) , 15-np);
  1469.               END;
  1470.       
  1471.               pixel.fdAddr := ADR(test);
  1472.               stdfm.fdAddr := ADR(test);
  1473.               MagicVDI.TransformForm (mtAppl.VDIHandle, stdfm, pixel);
  1474.               
  1475.               i := 1;
  1476.               WHILE (i < mtAppl.Bitplanes) & (test[i] # 0) DO
  1477.                 INC (i);
  1478.               END;
  1479.               
  1480.               IF (i >= mtAppl.Bitplanes) & ~(test[0] MOD 00FFH = 0)
  1481.                 THEN
  1482.                   bpp := 1;
  1483.                 END;
  1484.             ELSE
  1485.               MagicVDI.SetClipping (mtAppl.VDIHandle, pxy, FALSE);
  1486.               screen.fdAddr := NIL;
  1487.               
  1488.               Block.Clear (ADR(backup), SIZE (backup));
  1489.   
  1490.               i := MagicVDI.SetWritemode (mtAppl.VDIHandle, MagicVDI.REPLACE);
  1491.               MagicVDI.SetLineEndstyles (mtAppl.VDIHandle, 0, 0);
  1492.               i := MagicVDI.SetLinetype (mtAppl.VDIHandle, 1);
  1493.               i := MagicVDI.SetLinewidth (mtAppl.VDIHandle, 1);
  1494.               Block.Clear (ADR(pxy), SIZE (pxy));
  1495.   
  1496.               MagicAES.GrafMouse (MagicAES.MOFF, NIL);
  1497.           
  1498.               pixel.fdAddr := ADR(backup); (* Punkt retten *)
  1499.               MagicVDI.CopyRasterOpaque (mtAppl.VDIHandle, 3, pxy, screen, pixel);
  1500.           
  1501.               (* Alte Farbe retten *)
  1502.               MagicVDI.InqColor (mtAppl.VDIHandle, 15, FALSE, rgb);
  1503.       
  1504.               (* Ger„teabh„ngiges Format testen *)
  1505.               pixel.fdAddr := ADR(test);
  1506.               i := MagicVDI.SetLinecolor (mtAppl.VDIHandle, 15);
  1507.               MagicVDI.SetColor (mtAppl.VDIHandle, 15, white);
  1508.               MagicVDI.Polyline (mtAppl.VDIHandle, 2, pxy);
  1509.               
  1510.               Block.Clear (ADR(test), SIZE(test));
  1511.               
  1512.               MagicVDI.CopyRasterOpaque (mtAppl.VDIHandle, 3, pxy, screen, pixel);
  1513.               
  1514.               i := (mtAppl.Bitplanes + 15) DIV 16 * 2; 
  1515.               WHILE (i < mtAppl.Bitplanes) & (test[i] # 0) DO INC (i); END;
  1516.               
  1517.               IF (i >= mtAppl.Bitplanes)
  1518.                 THEN
  1519.                   MagicVDI.SetColor (mtAppl.VDIHandle, 15, black);
  1520.                   MagicVDI.Polyline (mtAppl.VDIHandle, 2, pxy);
  1521.                   
  1522.                   Block.Clear (ADR(test), SIZE(test));
  1523.                   MagicVDI.CopyRasterOpaque (mtAppl.VDIHandle, 3, pxy, screen, pixel);
  1524.                   
  1525.                   i := (mtAppl.Bitplanes + 15) DIV 16 * 2; 
  1526.                   WHILE (i < mtAppl.Bitplanes) & (test[i] # 0) DO INC (i); END;
  1527.                   
  1528.                   IF (i >= mtAppl.Bitplanes)
  1529.                     THEN
  1530.                       bpp := (mtAppl.Bitplanes + 7) DIV 8;
  1531.                     END;
  1532.                 END;
  1533.   
  1534.               (* Alte Farbe restaurieren *)
  1535.               MagicVDI.SetColor (mtAppl.VDIHandle, 15, rgb);
  1536.       
  1537.               pixel.fdAddr := ADR(backup); (* Punkt restaurieren *)
  1538.               MagicVDI.CopyRasterOpaque (mtAppl.VDIHandle, 3, pxy, pixel, screen);
  1539.           
  1540.               MagicAES.GrafMouse (MagicAES.MON, NIL);
  1541.       
  1542.               MagicVDI.SetClipping (mtAppl.VDIHandle, pxy, TRUE);
  1543.             END;
  1544.         END;
  1545.   
  1546.       RETURN bpp;
  1547.     END test_rez;
  1548.  
  1549.  
  1550. VAR cicon_liste : SYSTEM.ADDRESS;
  1551.     (*$Reg*) i  : sINTEGER;
  1552.     obj         : mtUtils.tObjcTree;
  1553.     nub         : sINTEGER;
  1554.     palette     : POINTER TO sINTEGER;
  1555.     ExtSlot     : tpExtSlot;
  1556.     
  1557.  
  1558.   BEGIN
  1559.     
  1560.     ExtSlot := header + rsxhdr^.rshRssize;
  1561.     IF ODD(lCARDINAL(ExtSlot))
  1562.       THEN
  1563.         ExtSlot := ExtSlot + SYSTEM.ADDRESS(1);
  1564.       END;
  1565.     cicon_liste := header + ExtSlot^.rscCIconTab;
  1566.     obj := mtUtils.tObjcTree(rsxhdr^.rshObject + header);
  1567.  
  1568.     IF (lCARDINAL(cicon_liste - header) > rsxhdr^.rshRssize)
  1569.         AND (lCARDINAL(cicon_liste - header) < rs_len)
  1570.       THEN
  1571.         IF (fill_cicon_liste (cicon_liste, header, rsxhdr) # 0)
  1572.           THEN
  1573.             nub := 0;
  1574.             
  1575.             IF (rs_par^.colictab # NIL)
  1576.               THEN
  1577.         
  1578.                 xpixelbytes := test_rez ();
  1579.  
  1580.                 (* haben wir noch keine Tabelle? Dann allozieren *)
  1581.                 IF (rgb_palette = NIL)
  1582.                   THEN
  1583.                     Storage.ALLOCATE(rgb_palette, SIZE(rgb_palette^));
  1584.                   END;
  1585.                 IF (farbtbl = NIL)
  1586.                   THEN
  1587.                     Storage.ALLOCATE(farbtbl, SIZE(farbtbl^));
  1588.                   END;
  1589.  
  1590.                 IF (ExtSlot^.rscFarbtbl = 1 )
  1591.                   THEN
  1592.                     palette := header + ExtSlot^.rscFarbtbl;
  1593. (*$? Compiler=Haenisch:
  1594.                     Block.Move(palette, rgb_palette, SIZE(rgb_palette));
  1595. *)
  1596. (*$? Compiler=Megamax:
  1597.                     Block.Copy(palette, SIZE(rgb_palette), rgb_palette);
  1598. *)
  1599.                     is_palette := TRUE;
  1600.                   ELSE
  1601.                     is_palette := FALSE;
  1602.                   END;
  1603.   
  1604.                 xfill_farbtbl ();
  1605.               
  1606.                 FOR i := 0 TO VAL(sINTEGER, rsxhdr^.rshNobs) - 1 DO
  1607.                   IF ((obj^[i].obType MOD 256) = MagicAES.GCICON)
  1608.                     THEN
  1609.                       IF ~xadd_cicon (obj^[i].obSpec.CiconPtr, obj^[i], nub)
  1610.                         THEN
  1611.                           Block.Clear(SYSTEM.ADR(rs_par^.colictab^[nub]), SYSTEM.TSIZE(MagicAES.CICON));
  1612.                           obj^[i].obType := (obj^[i].obType DIV 256 * 256) + MagicAES.GICON;
  1613.                         END;
  1614.                       INC(nub);
  1615.                       obj^[i].obSpec.address := obj^[i].obSpec.address - header;
  1616.                     END;
  1617.                 END;  (* FOR *)
  1618.               ELSE
  1619.                 FOR i := 0 TO VAL(sINTEGER, rsxhdr^.rshNobs) - 1 DO
  1620.                   IF ((obj^[i].obType MOD 256) = MagicAES.GCICON)
  1621.                     THEN
  1622.                       obj^[i].obType := (obj^[i].obType DIV 256 * 256) + MagicAES.GICON;
  1623.                       obj^[i].obSpec.address := obj^[i].obSpec.address - header;
  1624.                     END;
  1625.                 END;
  1626.               END;
  1627.           END; (* IF fill_iconliste *)
  1628.       END;  (* cicon_liste - header > ... *)
  1629.   END do_ciconfix;
  1630.  
  1631.  
  1632. PROCEDURE xrsrc_reloc (    Adr        : SYSTEM.ADDRESS;
  1633.                            length     : lCARDINAL;
  1634.                        VAR pglobal    : tRsBuffer) : BOOLEAN;
  1635. VAR i   : sINTEGER;
  1636.     ret : BOOLEAN;
  1637.  
  1638.   BEGIN
  1639.     ret := TRUE;
  1640.  
  1641.     rs_par := SYSTEM.ADR(pglobal);
  1642.  
  1643.     IF (length > SYSTEM.TSIZE(MagicTypes.RSHDR))
  1644.       THEN
  1645.         (* Speicher fr den Header *)
  1646.         Storage.ALLOCATE(rs_par^.xhdr, SYSTEM.TSIZE(RSXHDR));
  1647.         IF rs_par^.xhdr # NIL
  1648.           THEN
  1649.             rs_par^.rscdata := Adr;
  1650.  
  1651.             IF rs_par^.rscdata^.rshVrsn = 3
  1652.               THEN
  1653. (*$? Compiler=Haenisch:
  1654.                 Block.Move(rs_par^.rscdata, rs_par^.xhdr, SYSTEM.TSIZE(RSXHDR));
  1655. *)
  1656. (*$? Compiler=Megamax:
  1657.                 Block.Copy(rs_par^.rscdata, SYSTEM.TSIZE(RSXHDR), rs_par^.xhdr);
  1658. *)
  1659.               ELSE
  1660.                 FOR i := 0 TO (SYSTEM.TSIZE(RSXHDR) DIV SYSTEM.TSIZE(lINTEGER)) - 1 DO
  1661. (*$?Compiler=Megamax: (*$A+*) *)
  1662.                   tplCard(rs_par^.xhdr)^[i] := tpsCard(rs_par^.rscdata)^[i];
  1663. (*$?Compiler=Megamax: (*$A=*) *)
  1664.                 END;
  1665.               END;
  1666.     
  1667.  
  1668.             do_rsfix (rs_par^.xhdr^.rshRssize);
  1669.       
  1670.             IF (length > rs_par^.xhdr^.rshRssize + 72) (* Farbicons in der Resource? *)
  1671.               THEN
  1672.                 do_ciconfix (rs_par^.rscdata, rs_par^.xhdr, length);
  1673.               END;
  1674.       
  1675.           ELSE
  1676.             ret := FALSE;
  1677.           END;
  1678.       ELSE
  1679.         ret := FALSE;
  1680.       END;
  1681.  
  1682.     IF ret
  1683.       THEN
  1684.         rs_fixindex (pglobal);
  1685.       END;
  1686.  
  1687.     RETURN ret;
  1688.   END xrsrc_reloc;
  1689.  
  1690.  
  1691. (*$? Compiler = Haenisch:
  1692. PROCEDURE rs_read (VAR global : tRsBuffer; VAR fname : STRING) : BOOLEAN;
  1693. *)
  1694. (*$? Compiler = Megamax:
  1695. PROCEDURE rs_read (VAR global : tRsBuffer; REF fname : ARRAY OF CHAR) : BOOLEAN;
  1696. *)
  1697. VAR i, fh     : sINTEGER;
  1698.     tmpnam    : ARRAY[0..256] OF CHAR;
  1699.     dta       : MagicDOS.DTA;
  1700.     old_dta   : POINTER TO MagicDOS.DTA;
  1701.     read, size      : lCARDINAL;
  1702.     ret       : BOOLEAN;
  1703.  
  1704.   BEGIN
  1705.     ret := TRUE;        (* Annahme ok *)
  1706.  
  1707.     MagicStrings.Assign(fname, tmpnam);
  1708.  
  1709.     MagicAES.ShelFind(tmpnam);
  1710.  
  1711.     rs_par    := SYSTEM.ADR(global);
  1712.  
  1713.     old_dta := MagicDOS.Fgetdta ();
  1714.     MagicDOS.Fsetdta(SYSTEM.ADR(dta));
  1715.  
  1716.     (* Warum hier ber Fsfirst?
  1717.      * Wohl nur, um die Dateigr”že zu bekommen.
  1718.      *)
  1719.     IF MagicDOS.Fsfirst (tmpnam, sBITSET{Bit4}) = 0
  1720.       THEN
  1721.         size := dta.dLength;
  1722.       ELSE
  1723.         size := 0;
  1724.       END;
  1725.     MagicDOS.Fsetdta (old_dta);
  1726.  
  1727.     IF (size > SYSTEM.TSIZE (MagicTypes.RSHDR))
  1728.       THEN
  1729.         fh := MagicDOS.Fopen (tmpnam, {});
  1730.         IF fh > 0
  1731.           THEN
  1732.             Storage.ALLOCATE(rs_par^.xhdr, size + SYSTEM.TSIZE(RSXHDR));
  1733.             IF rs_par^.xhdr # NIL
  1734.               THEN
  1735.                 rs_par^.rscdata := rs_par^.xhdr + SYSTEM.ADDRESS(SYSTEM.TSIZE(RSXHDR));
  1736.  
  1737.                 read := size;
  1738.                 MagicDOS.Fread (fh, read, rs_par^.rscdata);
  1739.                 IF read = size
  1740.                   THEN
  1741.                     IF rs_par^.rscdata^.rshVrsn = 3
  1742.                       THEN
  1743. (*$? Compiler=Haenisch:
  1744.                         Block.Move(rs_par^.rscdata, rs_par^.xhdr, SYSTEM.TSIZE(RSXHDR));
  1745. *)
  1746. (*$? Compiler=Megamax:
  1747.                         Block.Copy(rs_par^.rscdata, SYSTEM.TSIZE(RSXHDR), rs_par^.xhdr);
  1748. *)
  1749.                       ELSE
  1750.                         FOR i := 0 TO SYSTEM.TSIZE(RSXHDR) DIV SYSTEM.TSIZE(lINTEGER) - 1 DO
  1751. (*$? Compiler=Megamax:    (*$A+*) *)
  1752.                           tplCard(rs_par^.xhdr)^[i] := tpsCard(rs_par^.rscdata)^[i];
  1753. (*$? Compiler=Megamax:    (*$A=*) *)
  1754.                         END;
  1755.                       END;
  1756.             
  1757.                     do_rsfix (rs_par^.xhdr^.rshRssize);
  1758.             
  1759.                     IF (size > rs_par^.xhdr^.rshRssize + 72) (* Farbicons in der Resource? *)
  1760.                       THEN
  1761.                         do_ciconfix (rs_par^.rscdata, rs_par^.xhdr, size);
  1762.                       END;
  1763.                   ELSE
  1764.                     ret := FALSE;
  1765.                   END;
  1766.               ELSE
  1767.                 ret := FALSE;
  1768.               END;
  1769.             
  1770.             void.I := MagicDOS.Fclose (fh);
  1771.           ELSE
  1772.             ret := FALSE;
  1773.           END;
  1774.       ELSE
  1775.         ret := FALSE;
  1776.       END;
  1777.  
  1778.     RETURN ret;
  1779.   END rs_read;
  1780.  
  1781.  
  1782. PROCEDURE NewRsc (): RESOURCE;
  1783. VAR new : RESOURCE;
  1784.   BEGIN
  1785.     Storage.ALLOCATE (new, SYSTEM.TSIZE(Resource));
  1786.     IF new # NIL
  1787.       THEN
  1788.         (* sicherheitshalber l”schen *)
  1789.         Block.Clear(new, SYSTEM.TSIZE(Resource));
  1790.         new^.last   := NIL;
  1791.         IF RscList # NIL
  1792.           THEN
  1793.             RscList^.last := new;  (* rckwarts verketten *)
  1794.           END;
  1795.         new^.next:= RscList;
  1796.         RscList := new;
  1797.       END;
  1798.     RETURN new;
  1799.   END NewRsc;
  1800.  
  1801. (*-------------------------------------------------------------------------*)
  1802. (*-                                                                       -*)
  1803. (*- exportierte Funktionen                                                -*)
  1804. (*-                                                                       -*)
  1805. (*-------------------------------------------------------------------------*)
  1806. PROCEDURE RelocRsc (address: SYSTEM.ADDRESS; VAR rsc: RESOURCE): BOOLEAN;
  1807. VAR length  : lCARDINAL;
  1808.     pRsc    : POINTER TO MagicTypes.RSHDR;
  1809.     pXRsc   : tpRSXHDR;
  1810.     pLC     : POINTER TO lCARDINAL;
  1811.  
  1812. BEGIN
  1813.   pRsc := address;
  1814.   pXRsc := address;
  1815.   IF sBITSET{Bit1, Bit0} * sBITSET{pRsc^.rshVrsn} = sBITSET{Bit1, Bit0}
  1816.     THEN
  1817.       length := pXRsc^.rshRssize;
  1818.     ELSE
  1819.       length := pRsc^.rshRssize;
  1820.     END;
  1821.  
  1822.   IF Bit2 IN sBITSET(pRsc^.rshVrsn)       (* Bit 2 markiert Erweiterungsslot *)
  1823.     THEN
  1824.       pLC := address + SYSTEM.ADDRESS(length);
  1825.       IF pLC^ # 0  (* Ist das der Erweiterungsslot? *)
  1826.         THEN
  1827.           (* Dort steht die Gesamtl„nge der Daten *)
  1828.           length := pLC^;
  1829.         END;
  1830.     END;
  1831.  
  1832.   rsc:= NewRsc ();
  1833.   IF (rsc # NIL)
  1834.     AND xrsrc_reloc(address, length, rsc^.RsBuffer)
  1835.     THEN
  1836.       RETURN TRUE;
  1837.     ELSE
  1838.       IF rsc # NIL
  1839.         THEN
  1840.           Storage.DEALLOCATE(rsc, 0);  (* wieder freigeben *)
  1841.         END;
  1842.       RETURN FALSE;
  1843.     END;
  1844.  
  1845. END RelocRsc;
  1846.  
  1847. (*$? Compiler = Haenisch:
  1848. PROCEDURE LoadRsc (VAR name: STRING; VAR rsc: RESOURCE): BOOLEAN;
  1849. *)
  1850. (*$? Compiler = Megamax:
  1851. PROCEDURE LoadRsc (REF  name: ARRAY OF CHAR ; VAR rsc: RESOURCE): BOOLEAN;
  1852. *)
  1853.  
  1854. BEGIN
  1855.   rsc:= NewRsc ();
  1856.   IF (rsc # NIL)
  1857.     AND rs_read (rsc^.RsBuffer, name)
  1858.     THEN
  1859.       rs_fixindex (rsc^.RsBuffer);
  1860.       RETURN TRUE;
  1861.     ELSE
  1862.       IF rsc # NIL
  1863.         THEN
  1864.           Storage.DEALLOCATE(rsc, 0);  (* wieder freigeben *)
  1865.         END;
  1866.       RETURN FALSE;
  1867.     END;
  1868. END LoadRsc;
  1869.  
  1870. PROCEDURE FreeRsc (VAR rsc: RESOURCE);
  1871. VAR count1, count2 : sCARDINAL;
  1872.  
  1873.   BEGIN
  1874.     IF rsc # NIL
  1875.       THEN
  1876.         IF rsc^.RsBuffer.colictab # NIL
  1877.           THEN
  1878.             FOR count1 := 0 TO rsc^.RsBuffer.colicons - 1 DO
  1879.               WITH rsc^.RsBuffer.colictab^[count1] DO
  1880.                 IF (numplanes > 1)
  1881.                   THEN
  1882.                     IF (coldata # NIL)
  1883.                       THEN
  1884.                         Storage.DEALLOCATE(coldata, 0);
  1885.                       END;
  1886.                     IF (seldata # NIL)
  1887.                       THEN
  1888.                         Storage.DEALLOCATE(seldata, 0);
  1889.                       END;
  1890.                     IF (seldata = NIL) AND (selmask # NIL)
  1891.                       THEN
  1892.                         Storage.DEALLOCATE(selmask, 0);
  1893.                       END;
  1894.                   END;
  1895.               END;
  1896.             END;
  1897.  
  1898.             (* Die noch belegten Userdefs freigeben *)
  1899.             WITH rsc^.RsBuffer DO
  1900.               FOR count1 := 0 TO VAL(sCARDINAL, xhdr^.rshNtree) - 1 DO
  1901.                 count2 := 0;
  1902.                 LOOP
  1903.                   IF tree^[count1]^[count2].obType MOD 256 = MagicAES.GPROGDEF
  1904.                     THEN
  1905.                       mtXobjects.FreeUserdef(tree^[count1], count2);
  1906.                     END;
  1907.                   IF MagicAES.LASTOB IN tree^[count1]^[count2].obFlags
  1908.                     THEN
  1909.                       EXIT;
  1910.                     END;
  1911.                   INC(count2);
  1912.                 END;  (* LOOP *)
  1913.               END;  (* FOR *)
  1914.             END;  (* WITH *)
  1915.           END;
  1916.         Storage.DEALLOCATE(rsc^.RsBuffer.colictab, 0);
  1917.  
  1918.         Storage.DEALLOCATE(rsc^.RsBuffer.xhdr, 0);
  1919.  
  1920.         IF rsc^.last # NIL
  1921.           THEN
  1922.             rsc^.last^.next:= rsc^.next;
  1923.           ELSE
  1924.             RscList:= rsc^.next;
  1925.           END;
  1926.         Storage.DEALLOCATE (rsc, 0);
  1927.       END;
  1928. END FreeRsc;
  1929.  
  1930. PROCEDURE FreeAll;
  1931.  
  1932. BEGIN
  1933.   WHILE RscList # NIL DO
  1934.  
  1935.     FreeRsc(RscList);
  1936.  
  1937.   END;
  1938.   RscList:= NIL;
  1939. END FreeAll;
  1940.  
  1941. PROCEDURE GaddrRsc (rsc: RESOURCE; type, item: sINTEGER): SYSTEM.ADDRESS;
  1942. VAR adr : SYSTEM.ADDRESS;
  1943.  
  1944.   BEGIN
  1945.     IF rsc # NIL
  1946.       THEN
  1947.         rs_par    := SYSTEM.ADR(rsc^.RsBuffer);
  1948.         RETURN get_address (type, item);
  1949.       ELSE
  1950.         RETURN NIL;
  1951.       END;
  1952.   END GaddrRsc;
  1953.  
  1954. PROCEDURE SaddrRsc (rsc: RESOURCE; type, item: sINTEGER; tree: SYSTEM.ADDRESS);
  1955. VAR old_addr, new_addr : POINTER TO MagicAES.OBJECT;
  1956.  
  1957.   BEGIN
  1958.     IF rsc # NIL
  1959.       THEN
  1960.         rs_par    := SYSTEM.ADR(rsc^.RsBuffer);
  1961.         old_addr := get_address (type, item);
  1962.         IF old_addr # NIL
  1963.           THEN
  1964.             new_addr := tree;
  1965.             old_addr^ := new_addr^;
  1966.           END;
  1967.       END;
  1968.   END SaddrRsc;
  1969.  
  1970. PROCEDURE ObfixRsc (rsc: RESOURCE; tree: SYSTEM.ADDRESS; object: sINTEGER);
  1971.  
  1972.   BEGIN
  1973.     IF rsc # NIL
  1974.       THEN
  1975.         rs_obfix (tree, object);
  1976.       END;
  1977.   END ObfixRsc;
  1978.  
  1979. PROCEDURE GetRscHeader (rsc: RESOURCE; VAR hdr: RSXHDR);
  1980. (* Liefert den RscHeader im langen Format *)
  1981. BEGIN
  1982.   hdr := rsc^.RsBuffer.xhdr^;
  1983. END GetRscHeader;
  1984.  
  1985.  
  1986. VAR Init : sCARDINAL;
  1987.  
  1988. PROCEDURE InitMtRsc();
  1989. BEGIN
  1990.   IF Init # 30961
  1991.     THEN
  1992.       xgl_wbox    := mtAppl.CharWidth;
  1993.       xgl_hbox    := mtAppl.CharHeight;
  1994.  
  1995.       rgb_palette := NIL;
  1996.       farbtbl     := NIL;
  1997.  
  1998.       Init := 30961;
  1999.       RscList:= NIL;
  2000.       mtAppl.InstallTermproc (FreeAll);
  2001.     END;
  2002. END InitMtRsc;
  2003.  
  2004. BEGIN
  2005. (*  Init := 0;*)
  2006.   InitMtRsc();
  2007. END mtRsc.
  2008.